home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / unixfasl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  8.6 KB  |  405 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. #define IN_UNIXFASL
  23. #include "include.h"
  24.  
  25. #ifdef UNIXFASL
  26. #include UNIXFASL
  27. #else
  28.  
  29. #ifdef HAVE_AOUT
  30. #undef BSD
  31. #undef ATT
  32. #define BSD
  33. #include HAVE_AOUT
  34. #endif
  35.  
  36. #ifdef COFF_ENCAPSULATE
  37. #undef BSD
  38. #undef ATT
  39. #define BSD
  40. #include "a.out.encap.h"
  41. #endif
  42.  
  43. #ifdef ATT
  44. #include <filehdr.h>
  45. #include <scnhdr.h>
  46. #include <syms.h>
  47. #endif
  48.  
  49. #ifdef E15
  50. #include <a.out.h>
  51. #define exec        bhdr
  52. #define a_text        tsize
  53. #define a_data        dsize
  54. #define a_bss        bsize
  55. #define a_syms        ssize
  56. #define a_trsize    rtsize
  57. #define a_drsize    rdsize
  58. #endif
  59.  
  60. #ifdef BSD
  61. #define    textsize    header.a_text
  62. #define    datasize    header.a_data
  63. #define    bsssize        header.a_bss
  64. #ifdef COFF_ENCAPSULATE
  65. #define    textstart    sizeof(header) +sizeof(struct coffheader)
  66. #else
  67. #define    textstart    sizeof(header)
  68. #endif
  69. #define    newbsssize    newheader.a_bss
  70. #endif
  71.  
  72. #ifndef HEADER_SEEK
  73. #define HEADER_SEEK
  74. #endif
  75.  
  76. #define    MAXPATHLEN    1024
  77.  
  78.  
  79. #ifndef SFASL
  80. int
  81. fasload(faslfile)
  82. object faslfile;
  83. {
  84.  
  85. #ifdef BSD
  86.     struct exec header, newheader;
  87. #endif    
  88.  
  89. #ifdef ATT
  90.     struct filehdr fileheader;
  91.     struct scnhdr sectionheader;
  92.     int textsize, datasize, bsssize;
  93.     int textstart;
  94. #endif
  95.  
  96. #ifdef E15
  97.     struct exec header;
  98. #define    textsize    header.a_text
  99. #define    datasize    header.a_data
  100. #define    bsssize        header.a_bss
  101. #define    textstart    sizeof(header)
  102. #endif
  103.  
  104.     object memory, data, tempfile;
  105.     FILE *fp;
  106.     char filename[MAXPATHLEN];
  107.     char tempfilename[32];
  108.     char command[MAXPATHLEN * 2];
  109.     int i;
  110.     object *old_vs_base = vs_base;
  111.     object *old_vs_top = vs_top;
  112. #ifdef IBMRT
  113.  
  114. #endif
  115.  
  116.     coerce_to_filename(faslfile, filename);
  117.  
  118.     faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
  119.     vs_push(faslfile);
  120.     fp = faslfile->sm.sm_fp;
  121.     /* seek to beginning of the header */
  122.  
  123.     HEADER_SEEK(fp);
  124.  
  125. #ifdef BSD
  126.     fread(&header, sizeof(header), 1, fp);
  127. #endif
  128. #ifdef ATT
  129.     fread(&fileheader, sizeof(fileheader), 1, fp);
  130. #ifdef S3000
  131.         if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1);
  132. #endif
  133.     fread(§ionheader, sizeof(sectionheader), 1, fp);
  134.     textsize = sectionheader.s_size;
  135.     textstart = sectionheader.s_scnptr;
  136.     fread(§ionheader, sizeof(sectionheader), 1, fp);
  137.     datasize = sectionheader.s_size;
  138.     fread(§ionheader, sizeof(sectionheader), 1, fp);
  139.     if (strcmp(sectionheader.s_name, ".bss") == 0)
  140.         bsssize = sectionheader.s_size;
  141.     else
  142.         bsssize = 0;
  143. #endif
  144. #ifdef E15
  145.     fread(&header, sizeof(header), 1, fp);
  146. #endif
  147.  
  148.     memory = alloc_object(t_cfdata);
  149.     memory->cfd.cfd_self = NULL;
  150.     memory->cfd.cfd_start = NULL;
  151.     memory->cfd.cfd_size = textsize + datasize + bsssize;
  152.     vs_push(memory);
  153.     memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,
  154.                           memory->cfd.cfd_size,sizeof(double));
  155.  
  156. #ifdef SEEK_TO_END_OFILE
  157. SEEK_TO_END_OFILE(fp);
  158. #else
  159. #ifdef BSD
  160.     fseek(fp,
  161.           header.a_text+header.a_data+
  162.           header.a_syms+header.a_trsize+header.a_drsize,
  163.           1);
  164.     fread(&i, sizeof(i), 1, fp);
  165.     fseek(fp, i - sizeof(i), 1);
  166. #endif
  167.  
  168. #ifdef ATT
  169.     fseek(fp,
  170.           fileheader.f_symptr + SYMESZ*fileheader.f_nsyms,
  171.           0);
  172.     fread(&i, sizeof(i), 1, fp);
  173.     fseek(fp, i - sizeof(i), 1);
  174.     while ((i = getc(fp)) == 0)
  175.         ;
  176.     ungetc(i, fp);
  177. #endif
  178.  
  179. #ifdef E15
  180.     fseek(fp,
  181.           header.a_text+header.a_data+
  182.           header.a_syms+header.a_trsize+header.a_drsize,
  183.           1);
  184. #endif
  185. #endif
  186.     data = read_fasl_vector(faslfile);
  187.     vs_push(data);
  188.     close_stream(faslfile, TRUE);
  189.  
  190.     sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
  191.  
  192. AGAIN:
  193.  
  194. #ifdef BSD
  195.     LD_COMMAND(command,
  196.         kcl_self,
  197.         memory->cfd.cfd_start,
  198.         filename,
  199.         " ",
  200.         tempfilename);
  201.      if(symbol_value(Vload_verbose)!=Cnil)        
  202.         printf("start address -T %x ",memory->cfd.cfd_start);
  203. #endif
  204. #ifdef ATT
  205.     coerce_to_filename(symbol_value(siVsystem_directory),
  206.                system_directory);
  207.     sprintf(command,
  208.         "%sild %s %d %s %s",
  209.         system_directory,
  210.         kcl_self,
  211.         memory->cfd.cfd_start,
  212.         filename,
  213.         tempfilename);
  214. #endif
  215. #ifdef E15
  216.     coerce_to_filename(symbol_value(siVsystem_directory),
  217.                system_directory);
  218.     sprintf(command,
  219.         "%sild %s %d %s %s",
  220.         system_directory,
  221.         kcl_self,
  222.         memory->cfd.cfd_start,
  223.         filename,
  224.         tempfilename);
  225. #endif
  226.  
  227.     if (system(command) != 0)
  228.         FEerror("The linkage editor failed.", 0);
  229.  
  230.     tempfile = make_simple_string(tempfilename);
  231.     vs_push(tempfile);
  232.     tempfile = open_stream(tempfile, smm_input, Cnil, Kerror);
  233.     vs_push(tempfile);
  234.     fp = tempfile->sm.sm_fp;
  235.  
  236.     HEADER_SEEK(fp);
  237.  
  238. #ifdef BSD
  239.     fread(&newheader, sizeof(header), 1, fp);
  240.     if (newbsssize != bsssize) {
  241.         insert_contblock(memory->cfd.cfd_start, memory->cfd.cfd_size);
  242.         bsssize = newbsssize;
  243.         memory->cfd.cfd_start = NULL;
  244.         memory->cfd.cfd_size = textsize + datasize + bsssize;
  245.         memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,memory->cfd.cfd_size,
  246.                              sizeof( double));
  247.         close_stream(tempfile, TRUE);
  248.         unlink(tempfilename);
  249.         goto AGAIN;
  250.     }
  251. #endif
  252.  
  253.     if (fseek(fp, textstart, 0) < 0)
  254.         error("file seek error");
  255.  
  256.     fread(memory->cfd.cfd_start, textsize + datasize, 1, fp);
  257.  
  258.     close_stream(tempfile, TRUE);
  259.  
  260.     unlink(tempfilename);
  261.  
  262.     call_init(0,memory,data);
  263.     
  264.     vs_base = old_vs_base;
  265.     vs_top = old_vs_top;
  266.  
  267.     return(memory->cfd.cfd_size);
  268. }
  269. #endif /* ifndef SFASL */
  270.  
  271. #ifndef __svr4__
  272. #ifdef BSD
  273.  
  274. #define FASLINK
  275. #ifndef PRIVATE_FASLINK
  276.  
  277. int
  278. faslink(faslfile, ldargstring)
  279.  
  280. object faslfile, ldargstring;
  281. {
  282.     struct exec header, faslheader;
  283.     object memory, data, tempfile;
  284.     FILE *fp;
  285.     char filename[MAXPATHLEN];
  286.     char ldargstr[MAXPATHLEN];
  287.     char tempfilename[32];
  288.     char command[MAXPATHLEN * 2];
  289.     char buf[BUFSIZ];
  290.     int i;
  291.     object *old_vs_base = vs_base;
  292.     object *old_vs_top = vs_top;
  293.  
  294.     coerce_to_filename(ldargstring, ldargstr);
  295.     coerce_to_filename(faslfile, filename);
  296.  
  297.     sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
  298.     LD_COMMAND(command,
  299.         kcl_self,
  300.         (int)core_end,
  301.         filename,
  302.         ldargstr,
  303.         tempfilename);
  304.  
  305.     if (system(command) != 0)
  306.         FEerror("The linkage editor failed.", 0);
  307.  
  308.     fp = fopen(tempfilename, "r");
  309.     setbuf(fp, buf);
  310.     fread(&header, sizeof(header), 1, fp);
  311.     memory = alloc_object(t_cfdata);
  312.     memory->cfd.cfd_self=0;
  313.     memory->cfd.cfd_start = NULL;
  314.     memory->cfd.cfd_size = textsize + datasize + bsssize;
  315.     vs_push(memory);
  316.     memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,
  317.                           memory->cfd.cfd_size,
  318.                           sizeof(double));
  319.     fclose(fp);
  320.  
  321.     faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
  322.     vs_push(faslfile);
  323. #ifdef SEEK_TO_END_OFILE
  324. SEEK_TO_END_OFILE(faslfile->sm.sm_fp);
  325. #else  
  326.     fp = faslfile->sm.sm_fp;
  327.     fread(&faslheader, sizeof(faslheader), 1, fp);
  328.     fseek(fp,
  329.           faslheader.a_text+faslheader.a_data+
  330.           faslheader.a_syms+faslheader.a_trsize+faslheader.a_drsize,
  331.           1);
  332.     fread(&i, sizeof(i), 1, fp);
  333.     fseek(fp, i - sizeof(i), 1);
  334. #endif
  335.     data = read_fasl_vector(faslfile);
  336.     vs_push(data);
  337.     close_stream(faslfile, TRUE);
  338.         LD_COMMAND(command,
  339.            kcl_self,
  340.            memory->cfd.cfd_start,
  341.            filename,
  342.            ldargstr,
  343.            tempfilename);
  344.      if(symbol_value(Vload_verbose)!=Cnil)    
  345.         printf("start address -T %x ",memory->cfd.cfd_start);
  346.     if (system(command) != 0)
  347.         FEerror("The linkage editor failed.", 0);
  348.  
  349.     tempfile = make_simple_string(tempfilename);
  350.     vs_push(tempfile);
  351.     tempfile = open_stream(tempfile, smm_input, Cnil, Kerror);
  352.     vs_push(tempfile);
  353.     fp = tempfile->sm.sm_fp;
  354.  
  355.     if (fseek(fp, textstart, 0) < 0)
  356.         error("file seek error");
  357.  
  358.     fread(memory->cfd.cfd_start, textsize + datasize, 1, fp);
  359.  
  360.     close_stream(tempfile, TRUE);
  361.  
  362.     unlink(tempfilename);
  363.  
  364.     call_init(0,memory,data);
  365.  
  366.     vs_base = old_vs_base;
  367.     vs_top = old_vs_top;
  368.  
  369.     return(memory->cfd.cfd_size);
  370. }
  371.  
  372. #endif
  373.  
  374. siLfaslink()
  375. {
  376.     bds_ptr old_bds_top;
  377.     int i;
  378.     object package;
  379.  
  380.     check_arg(2);
  381.     check_type_or_pathname_string_symbol_stream(&vs_base[0]);
  382.     check_type_string(&vs_base[1]);
  383.     vs_base[0] = coerce_to_pathname(vs_base[0]);
  384.     vs_base[0]->pn.pn_type = FASL_string;
  385.     vs_base[0] = namestring(vs_base[0]);
  386.     package = symbol_value(Vpackage);
  387.     old_bds_top = bds_top;
  388.     bds_bind(Vpackage, package);
  389.     i = faslink(vs_base[0], vs_base[1]);
  390.     bds_unwind(old_bds_top);
  391.     vs_top = vs_base;
  392.     vs_push(make_fixnum(i));
  393. }
  394.  
  395. #endif
  396. #endif/*  svr4 */
  397. #endif /* UNIXFASL */
  398.  
  399. init_unixfasl()
  400. {
  401. #ifdef FASLINK
  402.     make_si_function("FASLINK", siLfaslink);
  403. #endif
  404. }
  405.